home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / wx44.arc / WEATHER.BAS next >
Encoding:
BASIC Source File  |  1986-10-29  |  19.9 KB  |  481 lines
  1. 10 REM
  2. 20 REM      WEATHER FORECAST PROGRAM by Phil Baughn
  3. 30 REM
  4. 40 REM      This software program is distributed as "SHAREWARE".  You may
  5. 50 REM      feel free to copy and revise it as you like as long as you do
  6. 60 REM      not alter or remove the credit information in the program. If
  7. 70 REM      you find that you have made some significant improvements and
  8. 80 REM      additions to this package, please upload them to my attention
  9. 90 REM      either at The MAILROOM RBBS or to Compuserve; User#76044,1535.
  10. 100 REM      Enjoy!    Phil Baughn
  11. 110 REM
  12. 120 REM     Mailing address:          The MAILROOM RBBS-PC
  13. 130 REM                               attn.  Phil Baughn
  14. 140 REM                               2050 Idle Hour Center
  15. 150 REM                               Lexington, KY  40502
  16. 160 REM                               Data:  (606)293-5119
  17. 170 REM                               Voice: (606)268-0206
  18. 180 REM
  19. 190 REM     Special Credit to Mssrs. Bernard N. Meisner and Leon F. Graves
  20. 200 REM     who developed the Heat Index / Apparent Temperature Formula.
  21. 210 REM
  22. 220 GOSUB 830
  23. 230 REM     GET WELCOME SCREEN AND CREDITS IN ABOVE LINE
  24. 240 REM     GET MASTER WELCOME DOCUMENT IN FOLLOWING LINE
  25. 250 GOSUB 1100
  26. 260 REM
  27. 270 REM     PRINT MAIN MENU
  28. 280 REM
  29. 290 CLS:COLOR 14:LOCATE 9,20:PRINT "1 - WEATHER FORECAST PROGRAM"
  30. 300 COLOR 11:LOCATE 11,20:PRINT "2 - WIND CHILL CALCULATION"
  31. 310 COLOR 12:LOCATE 13,20:PRINT "3 - TEMPERATURE HUMIDITY INDEX"
  32. 320 COLOR 13:LOCATE 15,20:PRINT "4 - HEAT INDEX CALCULATION"
  33. 330 COLOR 14:LOCATE 17,20:PRINT "5 - DEW POINT CALCULATION"
  34. 340 COLOR 9:LOCATE 5,5:INPUT "ENTER THE NUMBER OF THE WEATHER PROGRAM WHICH YOU WISH TO RUN  ";CHOICE
  35. 350 REM
  36. 360 REM     GET FORCASTING SUNROUTINE
  37. 370 REM
  38. 380 IF CHOICE=1 THEN GOSUB 1400 ELSE GOTO 430
  39. 390 GOTO 620
  40. 400 REM
  41. 410 REM     GET WIND CHILL SUBROUTINE
  42. 420 REM
  43. 430 IF CHOICE=2 THEN GOSUB 2820 ELSE GOTO 480
  44. 440 GOTO 620
  45. 450 REM
  46. 460 REM     GET TEMP-HUMIDITY SUBROUTINE
  47. 470 REM
  48. 480 IF CHOICE=3 THEN GOSUB 4090 ELSE GOTO 530
  49. 490 GOTO 620
  50. 500 REM
  51. 510 REM     GET HEAT INDXE SUBROUTINE
  52. 520 REM
  53. 530 IF CHOICE=4 THEN GOSUB 3070 ELSE GOTO 580
  54. 540 GOTO 620
  55. 550 REM
  56. 560 REM     GET DEW POINT SUBROUTINE
  57. 570 REM
  58. 580 IF CHOICE=5 THEN GOSUB 4550 ELSE GOTO 290
  59. 590 REM
  60. 600 REM     LOOP OR QUIT
  61. 610 REM
  62. 620 LOCATE 24,14:INPUT "DO YOU WISH TO DO A DIFFERENT CALCULATION (Y/N)";D$
  63. 630 REM
  64. 640 REM     LOOP
  65. 650 REM
  66. 660 IF D$="Y" OR D$="y" THEN GOTO 290
  67. 670 REM
  68. 680 REM     QUIT WITH EPILOG SCREEN AND RESET COLORS TO NORMAL
  69. 690 REM
  70. 700 COLOR 9,0,0:CLS:LOCATE 9,23:PRINT "I hope you enjoyed WEATHER and"
  71. 710 LOCATE 11,21:PRINT "that your forecast was a good one."
  72. 720 LOCATE 15,20:PRINT "Let us here from you on The MAILROOM"
  73. 730 LOCATE 17,18:PRINT "Data (606)293-5119 - 2400 Baud Supported"
  74. 740 LOCATE 19,37:PRINT "- Phil Baughn"
  75. 750 COLOR 7,0,0:LOCATE 24,1
  76. 760 END
  77. 770 REM     ~~~~~~~~~~~~~~PROGRAM ENDS HERE~~~~~~~~~~~~~~
  78. 780 REM
  79. 790 REM     ~~~~~~~~SUBROUTINE MODULES BEGIN HERE~~~~~~~~
  80. 800 REM
  81. 810 REM     WELCOME SCREEN AND CREDITS SUBROUTINE
  82. 820 REM
  83. 830 KEY OFF:CLS
  84. 840 WIDTH 80:COLOR 11,0:LOCATE 5,5:PRINT CHR$(201):LOCATE 5,75:PRINT CHR$(187)
  85. 850 LOCATE 20,5:PRINT CHR$(200):LOCATE 20,75:PRINT CHR$(188)
  86. 860 FOR N=6 TO 19
  87. 870 LOCATE N,5:PRINT CHR$(186)
  88. 880 LOCATE N,75:PRINT CHR$(186)
  89. 890 NEXT N
  90. 900 FOR N=6 TO 74
  91. 910 LOCATE 5,N:PRINT CHR$(205)
  92. 920 LOCATE 20,N:PRINT CHR$(205)
  93. 930 NEXT N
  94. 940 COLOR 13,0:LOCATE 7,31:PRINT "WEATHER FORCASTING"
  95. 950 LOCATE 9,28:PRINT "DEVELOPED FOR THE IBM-PC"
  96. 960 LOCATE 10,39:PRINT "BY"
  97. 970 LOCATE 11,35:PRINT "PHIL BAUGHN"
  98. 980 LOCATE 13,14:PRINT "Special Thanks For Module Improvements To Sean Gayle"
  99. 990 LOCATE 14,11:PRINT "Of Louisiana & Brad James - Meteorologist, WKYT, Lexington"
  100. 1000 LOCATE 16,20:PRINT "Distributed Through The MAILROOM RBBS-PC"
  101. 1010 LOCATE 17,29:PRINT "In Lexington, Kentucky"
  102. 1020 LOCATE 18,22:PRINT "(606)293-5119   24 Hours - 2400 Baud"
  103. 1030 LOCATE 19,23:PRINT "Latest Revision [4.4]; August 1986"
  104. 1040 FOR N=1 TO 9999
  105. 1050 NEXT N
  106. 1060 RETURN
  107. 1070 REM
  108. 1080 REM     MAIN WELCOME DOCUMENT SUBROUTINE
  109. 1090 REM
  110. 1100 COLOR 14,1,1:CLS
  111. 1110 PRINT "  "
  112. 1120 PRINT "  "
  113. 1130 PRINT "    This  program  will provide  you with a very good forcast providing"
  114. 1140 PRINT "    you supply the correct  information  as to barometric  pressure and"
  115. 1150 PRINT "    wind direction.  This method has been used  for ages  by  sailors &"
  116. 1160 PRINT "    the tables  themselves can still be found in  almost  all  editions"
  117. 1170 PRINT "    of The Farmers Almanac."
  118. 1180 PRINT " "
  119. 1190 PRINT "    The other four programs which are included at present;  Wind Chill,"
  120. 1200 PRINT "    Dew Point, Temp/Humidity, & Heat Index; can be especially important"
  121. 1210 PRINT "    when working outdoors.  Wind Chill tells you the true  FEEL  of the"
  122. 1220 PRINT "    temperature  after the wind has it's effect.   It's not always safe"
  123. 1230 PRINT "    to simply  look  at the outdoor thermometer!  Humidity also effects"
  124. 1240 PRINT "    the temperature.   Higher humidity  levels  cause it to effect your"
  125. 1250 PRINT "    body as if it were hotter than the thermometer states."
  126. 1260 PRINT "  "
  127. 1270 PRINT "    Enjoy the program,   please pass along any  improvements  which you"
  128. 1280 PRINT "    may develop  or  additional  modules  which will fit well into  the"
  129. 1290 PRINT "    menu.   Listing  the  programs, lines 1-200, [ ie- LIST -200 ] will"
  130. 1300 PRINT "    provide you with more detailed contact information."
  131. 1310 PRINT "  "
  132. 1320 PRINT "  "
  133. 1330 PRINT "    Press any key when ready..."
  134. 1340 IF INKEY$ ="" GOTO 1340
  135. 1350 COLOR 7,0,0:CLS
  136. 1360 RETURN
  137. 1370 REM
  138. 1380 REM     WIND-BAROMETER FORECASTING SUBROUTINE
  139. 1390 REM
  140. 1400 CLS:COLOR 14:LOCATE 2,25:PRINT "WEATHER FORECAST PROGRAM"
  141. 1410 COLOR 5:LOCATE 4,32:PRINT DATE$:LOCATE 5,33:PRINT TIME$
  142. 1420 COLOR 3,0,0
  143. 1430 LOCATE 7,12
  144. 1440 INPUT "ENTER CURRENT BAROMETRIC PRESSURE                  ";CBP
  145. 1450 IF CBP<25 THEN 1430
  146. 1460 IF CBP>35 THEN 1430
  147. 1470 LOCATE 8,12
  148. 1480 INPUT "WIND DIRECTION IS CURRENTLY FROM THE               ";PWD$
  149. 1490 IF PWD$="SW" OR PWD$="sw" THEN 1500 ELSE 1530
  150. 1500 LOCATE 9,12
  151. 1510 INPUT "PREVIOUS WIND DIRECTION WAS FROM THE               ";PWD$
  152. 1520 GOTO 1650
  153. 1530 IF PWD$="SE" OR PWD$="se" THEN 1540 ELSE 1570
  154. 1540 LOCATE 9,12
  155. 1550 INPUT "PREVIOUS WIND DIRECTION WAS FROM THE               ";PWD$
  156. 1560 GOTO 1730
  157. 1570 IF PWD$="S" OR PWD$="s" THEN 1610
  158. 1580 IF PWD$="N" OR PWD$="n" THEN 1610
  159. 1590 IF PWD$="NW" OR PWD$="nw" THEN 1610
  160. 1600 IF PWD$="NE" OR PWD$="ne" THEN 1610 ELSE 1810
  161. 1610 LOCATE 18,23
  162. 1620 COLOR 9
  163. 1630 PRINT "NO IMMEDIATE CHANGE IS FORECAST"
  164. 1640 COLOR 7,0,0:GOTO 2760
  165. 1650 IF PWD$="S" OR PWD$="s" THEN 1670
  166. 1660 IF PWD$="NW" OR PWD$="nw" THEN 1690 ELSE 1710
  167. 1670 PWD$="M"
  168. 1680 GOTO 1860
  169. 1690 PWD$="N"
  170. 1700 GOTO 1860
  171. 1710 PWD$="O"
  172. 1720 GOTO 1860
  173. 1730 IF PWD$="NE" OR PWD$="ne" THEN 1750
  174. 1740 IF PWD$="S" OR PWD$="s" THEN 1770 ELSE 1790
  175. 1750 PWD$="P"
  176. 1760 GOTO 1860
  177. 1770 PWD$="Q"
  178. 1780 GOTO 1860
  179. 1790 PWD$="R"
  180. 1800 GOTO 1860
  181. 1810 IF PWD$="E" OR PWD$="e" THEN 1830
  182. 1820 IF PWD$="W" OR PWD$="w" THEN 1850
  183. 1830 PWD$="S"
  184. 1840 GOTO 1860
  185. 1850 PWD$="T"
  186. 1860 COLOR 4:LOCATE 13,12:PRINT "WIND CONDITION CODE IS ",PWD$;
  187. 1870 COLOR 3,0,0
  188. 1880 IF CBP>30.01 THEN 2050
  189. 1890 IF CBP<29.81 THEN 2200
  190. 1900 LOCATE 10,12
  191. 1910 INPUT "IS PRESSURE RISING (R), FALLING (F), OR STEADY (S) ";BM$
  192. 1920 IF BM$="F" OR BM$="f" THEN 1930 ELSE 2000
  193. 1930 LOCATE 11,12
  194. 1940 INPUT "IS IT FALLING RAPIDLY (R) OR SLOWLY (S)            ";BM$
  195. 1950 IF BM$="R" OR BM$="r" THEN 1960 ELSE 1980
  196. 1960 BM$="C6"
  197. 1970 GOTO 2270
  198. 1980 BM$="C5"
  199. 1990 GOTO 2270
  200. 2000 IF BM$="R" OR BM$="r" THEN 2010 ELSE 2030
  201. 2010 BM$="C7"
  202. 2020 GOTO 2270
  203. 2030 BM$="C0"
  204. 2040 GOTO 2270
  205. 2050 LOCATE 10,12
  206. 2060 INPUT "IS PRESSURE RISING (R), FALLING (F), OR STEADY (S) ";BM$
  207. 2070 IF BM$="F" OR BM$="f" THEN 2080 ELSE 2150
  208. 2080 LOCATE 11,12
  209. 2090 INPUT "IS IT FALLING RAPIDLY (R) OR SLOWLY (S)            ";BM$
  210. 2100 IF BM$="R" OR BM$="r" THEN 2110 ELSE 2130
  211. 2110 BM$="C4"
  212. 2120 GOTO 2270
  213. 2130 BM$="C3"
  214. 2140 GOTO 2270
  215. 2150 IF BM$="S" OR BM$="s" THEN 2160 ELSE 2180
  216. 2160 BM$="C1"
  217. 2170 GOTO 2270
  218. 2180 BM$="C2"
  219. 2190 GOTO 2270
  220. 2200 LOCATE 10,12
  221. 2210 INPUT "IS THE PRESSURE RISING (R) OR FALLING (F)          ";BM$
  222. 2220 IF BM$="R" OR BM$="r" THEN 2230 ELSE 2250
  223. 2230 BM$="C8"
  224. 2240 GOTO 2270
  225. 2250 BM$="C9"
  226. 2260 GOTO 2270
  227. 2270 COLOR 4:LOCATE 14,12:PRINT "BAROMETRIC CODE IS ",BM$
  228. 2280 COLOR 3,0,0
  229. 2290 IF PWD$="O" THEN 1610
  230. 2300 IF PWD$="R" THEN 1610
  231. 2310 LOCATE 17,18:PRINT "PLEASE WAIT - FORECAST BEING COMPUTED"
  232. 2320 FOR X=1 TO 3200:NEXT X
  233. 2330 LOCATE 17,18:PRINT "                                                 "
  234. 2340 IF PWD$="T" AND BM$="C8" THEN 2520
  235. 2350 IF PWD$="M" AND BM$="C7" THEN 2530
  236. 2360 IF PWD$="Q" AND BM$="C3" THEN 2550
  237. 2370 IF PWD$="Q" AND BM$="C4" THEN 2560
  238. 2380 IF PWD$="Q" AND BM$="C9" THEN 2570
  239. 2390 IF PWD$="P" AND BM$="C3" THEN 2590
  240. 2400 IF PWD$="P" AND BM$="C4" THEN 2600
  241. 2410 IF PWD$="P" AND BM$="C5" THEN 2610
  242. 2420 IF PWD$="P" AND BM$="C6" THEN 2620
  243. 2430 IF PWD$="P" AND BM$="C9" THEN 2570
  244. 2440 IF PWD$="S" AND BM$="C3" THEN 2640
  245. 2450 IF PWD$="S" AND BM$="C4" THEN 2660
  246. 2460 IF PWD$="S" AND BM$="C9" THEN 2700
  247. 2470 IF PWD$="N" AND BM$="C1" THEN 2720
  248. 2480 IF PWD$="N" AND BM$="C2" THEN 2740
  249. 2490 IF PWD$="N" AND BM$="C3" THEN 2750
  250. 2500 IF PWD$="N" AND BM$="C7" THEN 2530
  251. 2510 GOTO 1610
  252. 2520 LOCATE 17,30:COLOR 13:PRINT "CLEARING AND COLDER":GOTO 2760
  253. 2530 LOCATE 17,20:COLOR 13:PRINT "CLEARING WITHIN A FEW HOURS/"
  254. 2540 LOCATE 19,20:PRINT "FAIR FOR SEVERAL DAYS":GOTO 2760
  255. 2550 LOCATE 17,30:COLOR 13:PRINT "RAIN WITHIN 24 HOURS":GOTO 2760
  256. 2560 LOCATE 17,20:COLOR 13:PRINT "WIND INCREASING; RAIN WITHIN 24 HOURS":GOTO 2760
  257. 2570 LOCATE 17,15:COLOR 15:PRINT "SEVERE STORM IMMIMENT, FOLLOWED WITHIN 24 HOURS"
  258. 2580 LOCATE 19,15:PRINT "BY CLEARING. IN WINTER, COLDER TEMPERATURES.":GOTO 2760
  259. 2590 LOCATE 17,30:COLOR 13:PRINT "RAIN WITHIN 12 TO 18 HOURS":GOTO 2760
  260. 2600 LOCATE 17,20:COLOR 13:PRINT "WIND INCREASING; RAIN WITHIN 12 HOURS":GOTO 2760
  261. 2610 LOCATE 17,20:COLOR 13:PRINT "RAIN WILL CONTINUE FOR 1 TO 2 DAYS":GOTO 2760
  262. 2620 LOCATE 17,15:COLOR 13:PRINT "RAIN, WITH HIGH WIND, FOLLOWED WITHIN 36 HOURS BY"
  263. 2630 LOCATE 19,15:PRINT "CLEARING. IN WINTER - COLDER TEMPERATURES.":GOTO 2760
  264. 2640 LOCATE 17,15:COLOR 13:PRINT "SUMMER - LIGHT WINDS; RAIN MAY NOT FALL FOR"
  265. 2650 LOCATE 19,15:PRINT "SEVERAL DAYS.  WINTER - RAIN WITHIN 24 HOURS":GOTO 2760
  266. 2660 LOCATE 17,15:COLOR 13:PRINT "SUMMER RAIN PROBABLE 12/24 HOURS.  WINTER"
  267. 2670 LOCATE 19,15:PRINT "RAIN OR SNOW, INCREASING WIND; BAD WEATHER"
  268. 2680 LOCATE 21,15:PRINT "OFTEN SETS IN WHEN BAROMETER BEGINS TO FALL AND"
  269. 2690 LOCATE 23,15:PRINT "WINDS SET IN FROM THE NORTHEAST.":GOTO 2760
  270. 2700 LOCATE 17,15:COLOR 15:PRINT "SEVERE NORTHEAST GALE AND HEAVY PRECIPITATION,"
  271. 2710 LOCATE 19,15:PRINT "IN WINTER - HEAVY SNOW FOLLOWED BY A COLD WAVE":GOTO 2760
  272. 2720 LOCATE 17,20:COLOR 13:PRINT "CONTINUED FAIR WEATHER WITH"
  273. 2730 LOCATE 19,20:PRINT "NO DECIDED TEMPERATURE CHANGE":GOTO 2760
  274. 2740 LOCATE 17,20:COLOR 13:PRINT "FAIR, FOLLOWED WITHIN 2 DAYS BY RAIN":GOTO 2760
  275. 2750 LOCATE 17,15:COLOR 13:PRINT "FAIR FOR 2 DAYS WITH SLOWLY RISING TEMPERATURES"
  276. 2760 COLOR 7,0,0:LOCATE 24,17:INPUT "DO YOU WISH TO RUN ANOTHER FORECAST (Y/N)";L$
  277. 2770 IF L$="Y" OR L$="y" THEN GOTO 1400
  278. 2780 RETURN
  279. 2790 REM
  280. 2800 REM     WIND CHILL SUBROUTINE
  281. 2810 REM
  282. 2820 CLS:COLOR 11:LOCATE 2,27:PRINT "WIND CHILL CALCULATION"
  283. 2830 COLOR 5:LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
  284. 2840 COLOR 3,0,0:KEY OFF:LOCATE 7,12
  285. 2850 INPUT "ENTER TEMPERATURE IN FAHRENHEIT                    ";T
  286. 2860 LOCATE 8,12
  287. 2870 INPUT "ENTER WIND SPEED IN MILES PER HOUR                 ";V
  288. 2880 T1=T:V=(V*1609.35)/(3600):TC=33-((T-32)*(5/9))
  289. 2890 H=(10.45+(SQR(V)*10)-V)*TC:X=H-506.784
  290. 2900 IF X<0 THEN X1=T1:GOTO 3000
  291. 2910 X1=50-(X/12.3):X1=INT(((X1*10)+5)/10)
  292. 2920 COLOR 3:LOCATE 11,19:PRINT "PLEASE WAIT - WIND CHILL BEING COMPUTED"
  293. 2930 FOR ZZ=1 TO 1600:NEXT ZZ
  294. 2940 COLOR 4:LOCATE 13,17:PRINT "T1=T:V=(V*1069.35)/3600:TC=33-((T-32)*(5/9))"
  295. 2950 FOR ZZ=1 TO 800:NEXT ZZ
  296. 2960 LOCATE 14,20:PRINT "H=(10.45+(SQR(V)*10)-V)*TC:X=H-506.784"
  297. 2970 FOR ZZ=1 TO 800:NEXT ZZ
  298. 2980 LOCATE 15,21:PRINT "X1=50-(X/12.3):X1=INT(((X1*10)+5)/10)"
  299. 2990 FOR ZZ=1 TO 1600:NEXT ZZ
  300. 3000 COLOR 13:LOCATE 19,15:PRINT "WIND CHILL TEMPERATURE = ";X1;"DEGREES FAHRENHEIT"
  301. 3010 COLOR 7,0,0:LOCATE 24,19:INPUT "RUN ANOTHER WIND CHILL FACTOR (Y/N)";L$
  302. 3020 IF L$="Y" OR L$="y" THEN GOTO 2820
  303. 3030 RETURN
  304. 3040 REM
  305. 3050 REM     HEAT INDEX SUBROUTINE
  306. 3060 REM
  307. 3070 CLS:COLOR 11:LOCATE 2,27:PRINT "HEAT INDEX CALCULATION"
  308. 3080 COLOR 5:LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
  309. 3090 COLOR 3,0,0:KEY OFF:LOCATE 7,11
  310. 3100 INPUT "ENTER THE CURRENT TEMPERATURE IN DEGREES FAHRENHEIT ";TA
  311. 3110 U$="F"
  312. 3120 LOCATE 8,11
  313. 3130 INPUT "ENTER THE RELATIVE HUMIDITY  (`50'= 50% )           ";RH
  314. 3140 COLOR 9:LOCATE 11,18:PRINT "PLEASE WAIT - HEAT INDEX BEING COMPUTED"
  315. 3150 FOR ZZ=1 TO 1600:NEXT ZZ
  316. 3160 COLOR 4:LOCATE 13,23:PRINT "Heat Index Is Also Refered To"
  317. 3170 FOR ZZ=1 TO 800:NEXT ZZ
  318. 3180 LOCATE 14,17:PRINT "As The Apparent Temperature.  See The H/I"
  319. 3190 FOR ZZ=1 TO 800:NEXT ZZ
  320. 3200 LOCATE 15,18:PRINT "Explanation & Danger Table For Details."
  321. 3210 FOR ZZ=1 TO 1600:NEXT ZZ
  322. 3220 GOSUB 3530
  323. 3230 COLOR 11:LOCATE 19,19:PRINT "APPARENT TEMPERATURE = ";APPTEMP;" ";U$
  324. 3240 IF DF<0 THEN GOTO 3260
  325. 3250 GOTO 3270
  326. 3260 LOCATE 20,19:PRINT "SEVERE SULTRINESS..."
  327. 3270 COLOR 7,0,0:LOCATE 23,19:INPUT "RUN ANOTHER HEAT INDEX FACTOR (Y/N)";L$
  328. 3280 IF L$="Y" OR L$="y" THEN GOTO 3070
  329. 3290 LOCATE 24,16:INPUT "View H/I  Explanation & Danger Table? (Y/N)";CT$
  330. 3300 IF CT$="N" OR CT$="n" THEN GOTO 3520
  331. 3310 COLOR 14,1,1:CLS        
  332. 3320 PRINT "  "
  333. 3330 PRINT "       Your Present Calculated Heat Index Value Is" APPTEMP" "U$"."
  334. 3340 PRINT "  "
  335. 3350 PRINT "       When the  Heat Index reaches 130 degrees or higher, Heat"
  336. 3360 PRINT "       Strokes or  Sunstrokes are  HIGHLY likely with continued"
  337. 3370 PRINT "       exposure!   When the  Heat Index  ranges from 105 to 130"
  338. 3380 PRINT "       degrees,  sunstroke, heat exhaustion and heat cramps are"
  339. 3390 PRINT "       likely with  prolonged exposure and/or physical activity."
  340. 3400 PRINT "       Heat Index  ranges between 90 and 105 degrees indicate a"
  341. 3410 PRINT "       possibility  of  heat  cramps and  heat  exhaustion with"
  342. 3420 PRINT "       prolonged  exposure and/or physical activity."
  343. 3430 PRINT "  "
  344. 3440 PRINT "       Program calculations assume an adult, wearing long pants"
  345. 3450 PRINT "       and a  short sleeved shirt,  walking in shade at 3.1 MPH"
  346. 3460 PRINT "       with standard sea level air pressure,  a wind  speed  of"
  347. 3470 PRINT "       5.6 MPH, and a vapor pressure of 1.6kPa.  In effect, the"
  348. 3480 PRINT "       calculations  approximate the temperature  that  current"
  349. 3490 PRINT "       conditions feel like to the average person."
  350. 3500 PRINT "  "
  351. 3510 COLOR 7,0,0
  352. 3520 RETURN
  353. 3530 TC=TA
  354. 3540 IF U$="F" OR U$="f" THEN TC=(TA-32)*5/9
  355. 3550 ES=6.11*10^((7.567*TC)/(239.7+TC))
  356. 3560 E=.01*RH*ES
  357. 3570 GOTO 3610
  358. 3580 IF DF<0 THEN GOTO 3910
  359. 3590 IF U$="F" OR U$="f" THEN APPTEMP=32+1.8*APPTEMP
  360. 3600 RETURN
  361. 3610 TB=37:PB=5.65:Q=180:RS=.0387
  362. 3620 ZS=.0521:EHC=17.4:PHI2=.84
  363. 3630 R=.124:CHC=11.6:PINF=.1*E
  364. 3640 HER=4.18+.036*TC
  365. 3650 ERA=1/(EHC+HER)
  366. 3660 QV=Q*(.143-.00112*TC-.0168*PINF)
  367. 3670 EZA=.060606/EHC
  368. 3680 HR=3.35+.049*TC
  369. 3690 ARA=1/(CHC+HR)
  370. 3700 AZA=.060606/CHC
  371. 3710 Q2U=((TB-TC)+(PB-PINF)*ERA/(ZS+EZA))/(RS+ERA)
  372. 3720 QJ=(Q-QV-(1-PHI2)*Q2U)/PHI2
  373. 3730 K=(RS+ARA)+(ZS+AZA)/R-((TB-TC)+(PB-PINF)/R)/QJ
  374. 3740 L=(RS+ARA)*(ZS+AZA)
  375. 3750 L=(L-((TB-TC)*(ZS+AZA)+(PB-PINF)*ARA)/QJ)/R
  376. 3760 F=K*K-4*L
  377. 3770 IF F<0 THEN DF=-1
  378. 3780 IF F<0 THEN GOTO 3580
  379. 3790 RF=.5*(-K+SQR(F))
  380. 3800 DF=60*RF
  381. 3810 IF DF<0 THEN GOTO 3580
  382. 3820 W1=.2016
  383. 3830 W2=(1-PHI2)/(RS+ERA)
  384. 3840 W3=PHI2/(RS+RF+ARA)
  385. 3850 W4=159.0984
  386. 3860 W5=37
  387. 3870 W6=4.05*ERA/(ZS+EZA)
  388. 3880 W7=4.05*(RF+ARA)/(ZS+R*RF+AZA)
  389. 3890 APPTEMP=(-W4+W2*(W5+W6)+W3*(W5+W7))/(W1+W2+W3)
  390. 3900 GOTO 3580
  391. 3910 HC=12.3:HR=4.1+.028*TC
  392. 3920 RA=1/(HC+HR):ZA=.060606/HC
  393. 3930 QU=Q-QV
  394. 3940 FOR IT=1 TO 10
  395. 3950 ZS=((PB-PINF)*RA)/(QU*(RS+RA)-(TB-TC))-ZA
  396. 3960 IF ZS<0 THEN ZS=0
  397. 3970 R3=(ZS/600000!)^.2
  398. 3980 C=ABS(RS-R3)
  399. 3990 IF C<=.0001 THEN GOTO 4020
  400. 4000 RS=.5*(RS+R3)
  401. 4010 NEXT IT
  402. 4020 N1=159.0984:N2=37:N3=4.05*RA/(ZS+ZA)
  403. 4030 N4=(RS+RA):N5=.2016
  404. 4040 APPTEMP=(-N1+(N2+N3)/N4)/(N5+1/N4)
  405. 4050 GOTO 3590
  406. 4060 REM
  407. 4070 REM     TEMP-HUMIDITY INDEX SUBROUTINE
  408. 4080 REM
  409. 4090 CLS:COLOR 12:LOCATE 2,26:PRINT "TEMPERATURE HUMIDITY INDEX"
  410. 4100 COLOR 5:LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
  411. 4110 COLOR 3,0,0:KEY OFF:LOCATE 7,24:PRINT "THE TEMPERATURE HUMIDITY INDEX"
  412. 4120 LOCATE 8,21:PRINT "DETERMINES THE EFFECTIVE TEMPERATURE"
  413. 4130 LOCATE 11,12:INPUT "ENTER THE TEMPERATURE IN FAHRENHEIT                 ";T
  414. 4140 LOCATE 12,12:INPUT "ENTER THE RELATIVE HUMIDITY                         ";H
  415. 4150 LOCATE 15,15:PRINT "PLEASE WAIT - EFFECTIVE TEMPERATURE BEING COMPUTED"
  416. 4160 LOCATE 18,30:FOR C=1 TO 16
  417. 4170 COLOR (C):PRINT "!!!!!!!!!!!!!!!!!!!"
  418. 4180 LOCATE 18,30:C=C+1
  419. 4190 FOR ZXC=1 TO 400:NEXT ZXC
  420. 4200 NEXT C
  421. 4210 COLOR 3,0,0
  422. 4220 LOCATE 18,25:PRINT "                                   "
  423. 4230 IF H>94 THEN A=((.195*T)-15) ELSE IF H>89 AND H<95 THEN A=((.18*T)-15)
  424. 4240 IF H>79 AND H<90 THEN A=((.1667*T)-15) ELSE IF H>69 AND H<80 THEN A=((.145*T)-15)
  425. 4250 IF H>59 AND H<70 THEN A=((.1233*T)-15) ELSE IF H<60 THEN A=((.085*T)-15)
  426. 4260 TH=(((.8*T)+15)+A)
  427. 4270 COLOR 13:LOCATE 20,10:PRINT "THE TEMPERATURE HUMIDITY INDEX =  ";TH;"DEGREES FAHRENHEIT"
  428. 4280 COLOR 7,0,0:LOCATE 23,17:INPUT "ANOTHER TEMPERATURE HUMIDITY INDEX (Y/N)";L$
  429. 4290 IF L$="Y" OR L$="y" THEN GOTO 4090
  430. 4300 LOCATE 24,16:INPUT "View THI Explanation & Comfort Table? (Y/N)";CT$
  431. 4310 IF CT$="N" OR CT$="n" THEN GOTO 4330 
  432. 4320 GOTO 4340
  433. 4330 RETURN
  434. 4340 COLOR 14,1,1:CLS:PRINT "  "
  435. 4350 PRINT "    Your Temperature-Humidity Index reading was "TH"."
  436. 4360 PRINT "  "        
  437. 4370 PRINT "    Readings in excess of  70  represent the point  where a few people"
  438. 4380 PRINT "    begin  to  feel  uncomfortable.   Over 75, about 1/2 of all people"
  439. 4390 PRINT "    will feel uncomfortable. Nearly all people will feel uncomfortable"
  440. 4400 PRINT "    with  readings  over  79  with rapidly  decreasing work efficiency"
  441. 4410 PRINT "    begining  with  levels  in excess of  84;  and EXTREME DANGER with"
  442. 4420 PRINT "    possibility of heat  exhaustion  and heat stroke begin with levels"
  443. 4430 PRINT "    of 92 and higher."
  444. 4440 PRINT "  "
  445. 4450 PRINT "    The THI number, used to express the  combined temperature-humidity"
  446. 4460 PRINT "    effect provides a fairly good index of equivalent heat stress.  In"
  447. 4470 PRINT "    engineering, this combined index is refered to as `effective temp-"
  448. 4480 PRINT "    erature'. The weather bureau has also been known to refer to it as"
  449. 4490 PRINT "    the Discomfort Index.  It is NOT the same as the `Heat Index' even"
  450. 4500 PRINT "    though they both help to compute `Appearant' Temperatures.
  451. 4510 PRINT "  "
  452. 4520 PRINT "  "
  453. 4530 COLOR 7,0,0
  454. 4540 RETURN
  455. 4550 REM
  456. 4560 REM     DEW POINT SUBROUTINE
  457. 4570 REM
  458. 4580 CLS:COLOR 10:LOCATE 2,28:PRINT "DEW POINT CALCULATION"
  459. 4590 COLOR 5:LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
  460. 4600 COLOR 3,0,0:KEY OFF:LOCATE 7,12
  461. 4610 INPUT "ENTER TEMPERATURE IN FAHRENHEIT                    ";T
  462. 4620 LOCATE 8,12
  463. 4630 INPUT "ENTER THE RELATIVE HUMIDITY (`50' = 50%)           ";DPRH
  464. 4640 T=(T-32)*5/9
  465. 4650 X=1-(.01*DPRH)
  466. 4660 TD=T-(14.55+.114*T)*X-((2.5+.007*T)*X)^3-(15.9+.117*T)*X^14
  467. 4670 TD=(TD*9/5)+32
  468. 4680 COLOR 3:LOCATE 11,19:PRINT "PLEASE WAIT - DEW POINT BEING COMPUTED"
  469. 4690 FOR ZZ=1 TO 1600:NEXT ZZ
  470. 4700 COLOR 4:LOCATE 13,23:PRINT "TF=(T-32)*5/9:X=1-(.01*DPRH)"
  471. 4710 FOR ZZ=1 TO 800:NEXT ZZ
  472. 4720 LOCATE 14,9:PRINT "TD=T-(14.55+.114*T)*X-((2.5+.007*T)*X)^3-(15.9+.117*T)*X^14"
  473. 4730 FOR ZZ=1 TO 800:NEXT ZZ
  474. 4740 LOCATE 15,30:PRINT "TD=(TD*9/5)+32"
  475. 4750 FOR ZZ=1 TO 1600:NEXT ZZ
  476. 4760 COLOR 13:LOCATE 19,21:PRINT "DEW POINT CALCULATION = ";TD
  477. 4770 COLOR 7,0,0:LOCATE 24,20:INPUT "CALCULATE ANOTHER DEW POINT (Y/N)";L$
  478. 4780 IF L$="Y" OR L$="y" THEN GOTO 4580
  479. 4790 RETURN
  480. 4800 REM     ~~~~~~~~~~LAST LINE OF PROGRAM~~~~~~~~~
  481.